---
title: "The gender gap in household work narrowed more among married adults"
subtitle: "Average daily minutes of household activities reported by U.S. adults ages 25–64"
description: "Gap ribbons show the gender gap in daily household-activity minutes narrowing by 15 minutes among married U.S. adults between 2003–07 and 2021–25, with no statistically detectable narrowing among adults without a partner. Weighted ATUS means, with the difference in changes tested using BLS replicate weights. Built in R with ggplot2, ggtext, and showtext."
date: "2026-11-01"
author:
- name: "Steven Ponce"
url: "https://stevenponce.netlify.app"
citation:
url: "https://stevenponce.netlify.app/data_visualizations/SWD%20Challenge/2026/swd_2026_11.html"
categories: ["SWDchallenge", "2026"]
tags: [
"swd-challenge",
"story-of-change",
"gap-ribbon",
"slope-chart",
"small-multiples",
"direct-labeling",
"annotation",
"american-time-use-survey",
"household-work",
"gender-gap",
"replicate-weights",
"ggplot2",
"ggtext",
"2026"
]
image: "thumbnails/swd_2026_11.png"
format:
html:
toc: true
toc-depth: 5
code-link: true
code-fold: true
code-tools: true
code-summary: "Show code"
editor_options:
chunk_output_type: inline
execute:
freeze: true
cache: true
error: false
message: false
warning: false
eval: true
---
### Challenge
Change is constant—in life and in data. This month, your challenge is to create a visualization that helps your audience see what changed and why it matters. This month, we’re focusing on change. Whether you explore a dramatic shift or a subtle evolution, your task is to help your audience understand what’s different and why it deserves their attention.
Additional information can be found [HERE](https://community.storytellingwithdata.com/challenges/nov-2026-tell-a-story-of-change)
### Visualization
{#fig-1}
### Reproducibility
This page contains the R code used to generate the descriptive visualization.
**Data:** Download the ATUS 2003–2025 Activity Summary file from the [U.S. Bureau of Labor Statistics](https://www.bls.gov/tus/data/datafiles-0325.htm) and extract `atussum_0325.dat` to `data/SWDchallenge/2026/` in the personal-website repository.
The chart uses the ATUS final survey weight (`TUFNWGTP`). The reported 95% confidence interval was calculated separately using the 160 official BLS replicate weights.
The [statistical decision record](https://github.com/poncest/SWDchallenge/blob/main/2026/11_Nov/swd_2026_11_decision_record.R) is intended to reproduce that inferential analysis and requires the additional replicate-weights file, `atuswgts_0325.dat`.
The raw data files are not committed to GitHub because of their size. Reproduction also requires the custom plotting utilities and font setup included in this repository.
The published website uses Quarto's frozen execution and caching. To verify the calculations independently, rerun the analysis rather than relying on previously generated output.
### [**Steps to Create this Graphic**]{.mark}
#### [1. Load Packages & Setup]{.smallcaps}
```{r}
#| label: load
if (!require("pacman")) install.packages("pacman")
pacman::p_load(
tidyverse, ggtext, showtext, janitor, scales, glue, ggview
)
# Source utility functions
suppressMessages(source(here::here("R/utils/fonts.R")))
source(here::here("R/utils/social_icons.R"))
source(here::here("R/utils/image_utils.R"))
source(here::here("R/themes/base_theme.R"))
### |- figure settings ----
fig_w <- 11
fig_h <- 6.5
fig_dpi <- 320
### |- fonts ----
setup_fonts()
fonts <- get_font_families()
title_family <- fonts$title_1
text_family <- fonts$text
caption_family <- fonts$caption
```
#### [2. Read in the Data]{.smallcaps}
```{r}
#| label: read
data_path <- here::here("data/SWDchallenge/2026/atussum_0325.dat")
atus_raw <- read_csv(
data_path,
col_select = c(TUCASEID, TESEX, TEAGE, TRSPPRES, TUYEAR, TUFNWGTP, starts_with("t02")),
col_types = cols(TUCASEID = col_character(), .default = col_double())
)
```
#### [3. Examine the Data]{.smallcaps}
```{r}
#| label: examine
#| include: true
#| eval: true
#| results: 'hide'
#| warning: false
glimpse(atus_raw |> select(TUCASEID:TUFNWGTP))
atus_raw |> count(TUYEAR)
atus_raw |> count(TRSPPRES)
```
#### [4. Tidy Data]{.smallcaps}
```{r}
#| label: tidy
#| output: false
### |- analysis frame: ages 25-64, 2020 excluded, two pooled periods ----
hh_df <- atus_raw |>
mutate(hh_min = rowSums(pick(starts_with("t02")))) |>
filter(between(TEAGE, 25, 64), TUYEAR != 2020) |>
mutate(
period = case_when(
between(TUYEAR, 2003, 2007) ~ "2003–07",
between(TUYEAR, 2021, 2025) ~ "2021–25"
),
group = case_match(TRSPPRES, 1 ~ "Married adults", 3 ~ "Adults without a partner"),
sex = if_else(TESEX == 2, "women", "men")
) |>
filter(!is.na(period), !is.na(group))
### |- weighted means by group x period x sex ----
ribbon_df <- hh_df |>
summarise(minutes = weighted.mean(hh_min, TUFNWGTP), n = n(), .by = c(group, period, sex)) |>
mutate(
group = factor(group, levels = c("Married adults", "Adults without a partner")),
x = if_else(period == "2003–07", 1, 2)
)
gap_df <- ribbon_df |>
select(group, period, x, sex, minutes) |>
pivot_wider(names_from = sex, values_from = minutes) |>
mutate(gap = women - men)
get_val <- function(g, p, col) {
gap_df |>
filter(group == g, period == p) |>
pull({{ col }})
}
m_gap_1 <- get_val("Married adults", "2003–07", gap)
m_gap_2 <- get_val("Married adults", "2021–25", gap)
n_gap_1 <- get_val("Adults without a partner", "2003–07", gap)
n_gap_2 <- get_val("Adults without a partner", "2021–25", gap)
m_men_chg <- get_val("Married adults", "2021–25", men) - get_val("Married adults", "2003–07", men)
m_women_chg <- get_val("Married adults", "2021–25", women) - get_val("Married adults", "2003–07", women)
diff_in_changes <- (n_gap_2 - n_gap_1) - (m_gap_2 - m_gap_1)
# Validated using the official BLS replicate-weight analysis.
# This script reproduces the descriptive chart, not the CI.
# Retain the separate statistical decision record for full replication.
did_ci <- c(lo = 2.8, hi = 24.3)
```
#### [5. Visualization Parameters]{.smallcaps}
```{r}
#| label: params
### |- plot aesthetics ----
colors <- get_theme_colors(
palette = list(
women = "#2D3142",
men = "#7A8399",
band = "#DDD7CB",
accent = "#722F37",
soft = "#6B7080",
paper = "#F4F1EA"
)
)
clrs <- colors$palette
fallback <- c(
women = "#2D3142", men = "#7A8399", band = "#DDD7CB", accent = "#722F37",
soft = "#6B7080", paper = "#F4F1EA"
)
for (k in names(fallback)) if (is.null(clrs[[k]])) clrs[[k]] <- fallback[[k]]
### |- titles and caption ----
title_text <- "The gender gap in household work narrowed more among married adults"
subtitle_text <- "Average daily minutes of household activities reported by U.S. adults ages 25–64"
note_text <- glue(
"Household activities: housework, food preparation, lawn and garden, household management and similar. ",
"ATUS diaries record individual respondents, not couples. Married = spouse in the household; without a partner = ",
"no spouse or unmarried partner in the household. Cohabiting adults not shown. The gap narrowed {round(diff_in_changes, 1)} ",
"minutes more among married adults than among adults without a partner (95% CI {did_ci[['lo']]}–{did_ci[['hi']]}, BLS replicate weights). 2020 excluded. ",
"Values are rounded, so differences may not match exactly.<br>"
)
caption_text <- paste0(
note_text, "<br>",
create_swd_caption(
year = 2026,
month = "Nov",
source_text = "U.S. Bureau of Labor Statistics, American Time Use Survey 2003–2025"
)
)
ann_df <- tibble(
group = factor(c("Married adults", "Adults without a partner"), levels = levels(ribbon_df$group)),
label = c(
glue("Gap narrowed by {round(m_gap_1 - m_gap_2)} minutes a day:\nmen's minutes rose, women's fell"),
"No statistically detectable narrowing"
),
colour = c(clrs$accent, clrs$soft)
) |>
left_join(gap_df |> filter(x == 2) |> select(group, men), by = "group") |>
mutate(y = men - 14)
### |- in-band gap labels ("gap" named once: married panel, 2003-07 side) ----
gap_lab <- gap_df |>
mutate(
y = (women + men) / 2,
label = if_else(group == "Married adults" & x == 1,
as.character(glue("gap {round(gap)}")), as.character(round(gap))
),
hjust = if_else(x == 1, 0, 1),
x = if_else(x == 1, x + 0.06, x - 0.06)
)
end_labels <- ribbon_df |>
mutate(label = if_else(x == 1, as.character(glue("{sex} {round(minutes)}")), as.character(round(minutes))))
### |- plot theme ----
base_theme <- create_base_theme(colors)
weekly_theme <- extend_weekly_theme(
base_theme,
theme(
plot.background = element_rect(fill = clrs$paper, colour = NA),
panel.background = element_rect(fill = clrs$paper, colour = NA),
plot.title = element_text(
family = title_family, size = rel(1.6), colour = clrs$women,
margin = margin(b = 8)
),
plot.subtitle = element_text(
family = text_family, size = rel(0.92), colour = clrs$women,
lineheight = 1.2, margin = margin(b = 16)
),
plot.caption = element_textbox_simple(
family = caption_family, size = rel(0.55), colour = clrs$soft,
lineheight = 1.25, width = unit(1, "npc"), halign = 0,
margin = margin(t = 14)
),
plot.title.position = "plot", plot.caption.position = "plot",
strip.text = element_text(
family = text_family, face = "bold", size = rel(1.0), colour = clrs$women,
hjust = 0, margin = margin(b = 8)
),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
axis.text = element_text(family = text_family, colour = clrs$soft, size = rel(0.85)),
axis.text.x = element_text(family = text_family, colour = clrs$soft, size = rel(0.75)),
axis.ticks = element_blank(),
panel.grid.minor = element_blank(), panel.grid.major.x = element_blank(),
panel.grid.major.y = element_line(colour = "#E2DDD3", linewidth = 0.3),
panel.spacing = unit(2.5, "lines"),
plot.margin = margin(18, 24, 12, 16)
)
)
theme_set(weekly_theme)
```
#### [6. Plot]{.smallcaps}
```{r}
#| label: plot
#| output: false
### |- plot ----
p <- ggplot() +
# Geoms
geom_ribbon(data = gap_df, aes(x = x, ymin = men, ymax = women), fill = clrs$band) +
geom_text(
data = gap_lab, aes(x, y, label = label, hjust = hjust),
family = text_family, size = 3.2, colour = clrs$soft
) +
geom_line(data = ribbon_df, aes(x, minutes, group = sex, colour = sex), linewidth = 0.8) +
geom_point(data = ribbon_df, aes(x, minutes, colour = sex), size = 2.6) +
geom_text(
data = filter(end_labels, x == 1), aes(x - 0.06, minutes, label = label),
hjust = 1, family = text_family, size = 3.4, colour = clrs$women
) +
geom_text(
data = filter(end_labels, x == 2), aes(x + 0.06, minutes, label = label),
hjust = 0, family = text_family, size = 3.4, colour = clrs$women
) +
# Annotations
geom_text(
data = ann_df[1, ], aes(x = 1.5, y = y, label = label), colour = clrs$accent,
family = text_family, size = 3.5, fontface = "bold", lineheight = 1.0, vjust = 1
) +
geom_text(
data = ann_df[2, ], aes(x = 1.5, y = y, label = label), colour = clrs$soft,
family = text_family, size = 3.5, fontface = "bold", lineheight = 1.0, vjust = 1
) +
# Scales
scale_colour_manual(values = c(men = clrs$men, women = clrs$women), guide = "none") +
scale_x_continuous(breaks = 1:2, labels = c("2003–07", "2021–25"), limits = c(0.55, 2.45)) +
scale_y_continuous(breaks = seq(60, 180, 30)) +
coord_cartesian(ylim = c(50, 175), clip = "off") +
facet_wrap(~group) +
# Labs
labs(title = title_text, subtitle = subtitle_text, caption = caption_text, y = NULL)
```
#### [7. Save]{.smallcaps}
```{r}
#| label: save
#| warning: false
### |- save ----
main_path <- here::here("data_visualizations", "SWD Challenge", "2026", "swd_2026_11.png")
thumb_path <- here::here("data_visualizations", "SWD Challenge", "2026", "thumbnails", "swd_2026_11.png")
# Full-size version, for the QMD figure
save_ggplot(
plot = p,
file = main_path,
width = fig_w,
height = fig_h,
units = "in",
dpi = fig_dpi,
create.dir = TRUE
)
# Reduced-size thumbnail, for the YAML `image:` field
fs::dir_create(dirname(thumb_path))
magick::image_read(main_path) |>
magick::image_resize("400") |>
magick::image_write(thumb_path)
```
#### [8. Session Info]{.smallcaps}
::: {.callout-tip collapse="true"}
##### Expand for Session Info
```{r, echo = FALSE}
#| eval: true
#| warning: false
sessionInfo()
```
:::
#### [9. GitHub Repository]{.smallcaps}
::: {.callout-tip collapse="true"}
##### Expand for GitHub Repo
The complete code for this analysis is available in [`swd_2026_11.qmd`](https://github.com/poncest/personal-website/tree/master/data_visualizations/SWD%20Challenge/2026/swd_2026_11.qmd). For the full repository, [click here](https://github.com/poncest/personal-website/).
:::
#### [10. References]{.smallcaps}
::: {.callout-tip collapse="true"}
##### Expand for References
**SWD Challenge:**
- Storytelling with Data: [November 2026 — tell a story of change](https://community.storytellingwithdata.com/challenges/nov-2026-tell-a-story-of-change)
**Data Sources:**
- U.S. Bureau of Labor Statistics. *American Time Use Survey (ATUS) 2003–2025 Multi-Year Microdata Files.* <https://www.bls.gov/tus/data/datafiles-0325.htm>
- *Activity Summary file* (`atussum_0325.dat`): total minutes each respondent spent on each activity on their diary day. The chart's outcome is the sum of the 32 household-activity codes (`t02*`), with means weighted by `TUFNWGTP`.
- *Replicate Weights file* (`atuswgts_0325.dat`): 160 replicate weights, used only to compute confidence intervals. These do not appear on the chart, apart from the CI in the caption.
- U.S. Bureau of Labor Statistics. *ATUS 2003–2025 Coding Lexicon.* <https://www.bls.gov/tus/lexicons/lexiconnoex0325.pdf>: the definitions of the household-activity (`t02`) codes.
- U.S. Bureau of Labor Statistics. *American Time Use Survey User's Guide.* <https://www.bls.gov/tus/atususersguide.pdf>: the successive-difference replication variance method, Var = 4/160 × Σ(θᵣ − θ₀)².
**Analysis Frame:**
- Ages 25–64. The two periods are 2003–07 and 2021–25, and 2020 is excluded.
- Groups come from `TRSPPRES`: 1 = spouse present (married); 3 = no spouse or unmarried partner in the household. Cohabiting adults (2) are left out of the chart.
- The data are individual respondents, not matched couples. The comparison is descriptive, not causal.
**Data Preparation:**
- Decision record: [`swd_2026_11_decision_record.R`](https://github.com/poncest/SWDchallenge/blob/main/2026/11_Nov/swd_2026_11_decision_record.R). It recomputes the difference in gap changes between the groups (13.6 minutes, 95% CI 2.8–24.3) and the component changes, using BLS replicate weights. It is kept separate from the chart script.
- The raw `.dat` files are not in the repository. Download them from the BLS link above.
:::
#### [11. Custom Functions Documentation]{.smallcaps}
::: {.callout-note collapse="true"}
##### 📦 Custom Helper Functions
This analysis uses custom functions from my personal module library for efficiency and consistency across projects.
**Functions Used:**
- **`fonts.R`**: `setup_fonts()`, `get_font_families()` - Font management with showtext
- **`social_icons.R`**: `create_swd_caption()` - Generates the SWD caption with source and social handles
- **`base_theme.R`**: `create_base_theme()`, `extend_weekly_theme()`, `get_theme_colors()` - Custom ggplot2 themes
**Why custom functions?**\
These utilities standardize theming, fonts, and output across all my data visualizations. The core analysis (data tidying and visualization logic) uses only standard tidyverse packages.
**Source Code:**\
View all custom functions → [GitHub: R/utils](https://github.com/poncest/personal-website/tree/master/R)
:::